home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / pixelc1a / frmabout.frm (.txt) < prev    next >
Visual Basic Form  |  1999-07-30  |  11KB  |  246 lines
  1. VERSION 5.00
  2. Begin VB.Form frmAbout 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "About MyApp"
  5.    ClientHeight    =   3555
  6.    ClientLeft      =   2340
  7.    ClientTop       =   1935
  8.    ClientWidth     =   5730
  9.    ClipControls    =   0   'False
  10.    LinkTopic       =   "Form2"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   2453.724
  14.    ScaleMode       =   0  'User
  15.    ScaleWidth      =   5380.766
  16.    ShowInTaskbar   =   0   'False
  17.    StartUpPosition =   2  'CenterScreen
  18.    Begin VB.CommandButton cmdOK 
  19.       Cancel          =   -1  'True
  20.       Caption         =   "OK"
  21.       Default         =   -1  'True
  22.       Height          =   345
  23.       Left            =   4245
  24.       TabIndex        =   0
  25.       Top             =   2625
  26.       Width           =   1260
  27.    End
  28.    Begin VB.CommandButton cmdSysInfo 
  29.       Caption         =   "&System Info..."
  30.       Height          =   345
  31.       Left            =   4260
  32.       TabIndex        =   1
  33.       Top             =   3075
  34.       Width           =   1245
  35.    End
  36.    Begin VB.Image Image1 
  37.       Height          =   480
  38.       Left            =   120
  39.       Picture         =   "frmAbout.frx":0000
  40.       Top             =   240
  41.       Width           =   480
  42.    End
  43.    Begin VB.Line Line2 
  44.       Index           =   1
  45.       X1              =   957.833
  46.       X2              =   4676.478
  47.       Y1              =   704.022
  48.       Y2              =   704.022
  49.    End
  50.    Begin VB.Line Line2 
  51.       Index           =   0
  52.       X1              =   957.833
  53.       X2              =   4676.478
  54.       Y1              =   414.131
  55.       Y2              =   414.131
  56.    End
  57.    Begin VB.Line Line1 
  58.       BorderColor     =   &H00808080&
  59.       BorderStyle     =   6  'Inside Solid
  60.       Index           =   1
  61.       X1              =   84.515
  62.       X2              =   5309.398
  63.       Y1              =   1687.583
  64.       Y2              =   1687.583
  65.    End
  66.    Begin VB.Label lblDescription 
  67.       Caption         =   "App Description"
  68.       ForeColor       =   &H00000000&
  69.       Height          =   1170
  70.       Left            =   1080
  71.       TabIndex        =   2
  72.       Top             =   1200
  73.       Width           =   3885
  74.    End
  75.    Begin VB.Label lblTitle 
  76.       Caption         =   "Application Title"
  77.       ForeColor       =   &H00000000&
  78.       Height          =   300
  79.       Left            =   1050
  80.       TabIndex        =   4
  81.       Top             =   240
  82.       Width           =   3885
  83.    End
  84.    Begin VB.Line Line1 
  85.       BorderColor     =   &H00FFFFFF&
  86.       BorderWidth     =   2
  87.       Index           =   0
  88.       X1              =   98.6
  89.       X2              =   5309.398
  90.       Y1              =   1697.936
  91.       Y2              =   1697.936
  92.    End
  93.    Begin VB.Label lblVersion 
  94.       Caption         =   "Version"
  95.       Height          =   225
  96.       Left            =   1050
  97.       TabIndex        =   5
  98.       Top             =   720
  99.       Width           =   3885
  100.    End
  101.    Begin VB.Label lblDisclaimer 
  102.       Caption         =   "Warning: ..."
  103.       ForeColor       =   &H00000000&
  104.       Height          =   825
  105.       Left            =   255
  106.       TabIndex        =   3
  107.       Top             =   2625
  108.       Width           =   3870
  109.    End
  110. Attribute VB_Name = "frmAbout"
  111. Attribute VB_GlobalNameSpace = False
  112. Attribute VB_Creatable = False
  113. Attribute VB_PredeclaredId = True
  114. Attribute VB_Exposed = False
  115. Option Explicit
  116. '------------------------------------------------------------
  117. 'Define constants
  118. '------------------------------------------------------------
  119. ' Reg Key Security Options...
  120. Const READ_CONTROL = &H20000
  121. Const KEY_QUERY_VALUE = &H1
  122. Const KEY_SET_VALUE = &H2
  123. Const KEY_CREATE_SUB_KEY = &H4
  124. Const KEY_ENUMERATE_SUB_KEYS = &H8
  125. Const KEY_NOTIFY = &H10
  126. Const KEY_CREATE_LINK = &H20
  127. Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
  128.                        KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
  129.                        KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
  130.                      
  131. ' Reg Key ROOT Types...
  132. Const HKEY_LOCAL_MACHINE = &H80000002
  133. Const ERROR_SUCCESS = 0
  134. Const REG_SZ = 1                         ' Unicode nul terminated string
  135. Const REG_DWORD = 4                      ' 32-bit number
  136. Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
  137. Const gREGVALSYSINFOLOC = "MSINFO"
  138. Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
  139. Const gREGVALSYSINFO = "PATH"
  140. '------------------------------------------------------------
  141. 'Function Declarations
  142. '------------------------------------------------------------
  143. Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
  144. Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
  145. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  146. Private Sub cmdSysInfo_Click()
  147.   Call StartSysInfo
  148. End Sub
  149. Private Sub cmdOK_Click()
  150.   Unload Me
  151. End Sub
  152. Private Sub Form_Load()
  153.     App.Title = "Pixel Collision Detection"
  154.     Me.Caption = "About " & App.Title
  155.     lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
  156.     lblTitle.Caption = App.Title
  157.     lblDescription.Caption = "This program demonstrates how to performs accurate pixel collision detection"
  158.     lblDisclaimer = "Author : Richard Lowe " & vbCrLf & "Contact : riklowe@hotmail.com" & vbCrLf & "(c) 1999 R.Lowe"
  159. End Sub
  160. Public Sub StartSysInfo()
  161. '------------------------------------------------------------
  162. 'Locate the Sysinfo program and run
  163. '------------------------------------------------------------
  164. On Error GoTo SysInfoErr
  165.     Dim rc As Long
  166.     Dim SysInfoPath As String
  167. '------------------------------------------------------------
  168. ' Try To Get System Info Program Path\Name From Registry...
  169. '------------------------------------------------------------
  170.     If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) = False Then
  171.         If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) = False Then
  172.             If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
  173.                 SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
  174.             Else
  175.                 GoTo SysInfoErr
  176.             End If
  177.         Else
  178.             GoTo SysInfoErr
  179.         End If
  180.     End If
  181. '------------------------------------------------------------
  182. 'Run Sysinfo
  183. '------------------------------------------------------------
  184.     Call Shell(SysInfoPath, vbNormalFocus)
  185. Exit Sub
  186. '------------------------------------------------------------
  187. 'Error Handler
  188. '------------------------------------------------------------
  189. SysInfoErr:
  190.     MsgBox "System Information Is Unavailable At This Time", vbOKOnly
  191. End Sub
  192. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  193. '------------------------------------------------------------
  194. 'Read Registry
  195. '------------------------------------------------------------
  196. Dim i As Long                                               ' Loop Counter
  197. Dim rc As Long                                              ' Return Code
  198. Dim hKey As Long                                            ' Handle To An Open Registry Key
  199. Dim hDepth As Long                                          '
  200. Dim KeyValType As Long                                      ' Data Type Of A Registry Key
  201. Dim tmpVal As String                                        ' Tempory Storage For A Registry Key Value
  202. Dim KeyValSize As Long                                      ' Size Of Registry Key Variable
  203. '------------------------------------------------------------
  204. ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
  205. '------------------------------------------------------------
  206.     rc = RegOpenKeyEx(KeyRoot, KeyName, 0, _
  207.                       KEY_ALL_ACCESS, hKey)                 ' Open Registry Key
  208.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Err